sdk/samples/all in on code/Visual Studio 2008/VBExcelAutomationAddIn/MyFunctions.vb

   1 '****************************** Module Header ******************************'
   2 ' Module Name:  MyFunctions.vb
   3 ' Project:      VBExcelAutomationAddIn
   4 ' Copyright (c) Microsoft Corporation.
   5 '
   6 ' The VBExcelAutomationAddIn project is a class library project written in VB.
   7 ' It illustrates how to write a managed COM component which can be used as an
   8 ' Automation AddIn in Excel. The Automation AddIn can provide user defined
   9 ' functions for Excel.
  10 '
  11 ' This source is subject to the Microsoft Public License.
  12 ' See http://www.microsoft.com/opensource/licenses.mspx#Ms-PL.
  13 ' All other rights reserved.
  14 '
  15 ' THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND,
  16 ' EITHER EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED
  17 ' WARRANTIES OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
  18 '***************************************************************************'
  19
  20 #Region "Imports directives"
  21
  22 Imports System.Runtime.InteropServices
  23 Imports System.Text
  24 Imports Microsoft.Win32
  25 Imports Excel = Microsoft.Office.Interop.Excel
  26 Imports System.Reflection
  27
  28 #End Region
  29
  30
  31 <ComVisible(True), _
  32 ClassInterface(ClassInterfaceType.AutoDual), _
  33 Guid("83111578-8F0D-4821-835A-714DD2AACE3B")> _
  34 Public Class MyFunctions
  35
  36 #Region "User Defined Functions"
  37
  38     Public Function MinusNumbers(ByVal num1 As Double, _
  39                                Optional ByVal num2 As Object = Nothing, _
  40                                Optional ByVal num3 As Object = Nothing) _
  41                                As Double
  42
  43         Dim result As Double = num1
  44         If Not TypeOf num2 Is Missing And Not num2 Is Nothing Then
  45             Dim r2 As Excel.Range = TryCast(num2, Excel.Range)
  46             result = (result - Convert.ToDouble(r2.get_Value2))
  47         End If
  48         If Not TypeOf num3 Is Missing And Not num3 Is Nothing Then
  49             Dim r3 As Excel.Range = TryCast(num3, Excel.Range)
  50             result = (result - Convert.ToDouble(r3.get_Value2))
  51         End If
  52         Return result
  53
  54     End Function
  55
  56     Public Function NumberOfCells(ByVal range As Object) As Double
  57         Dim r As Excel.Range = TryCast(range, Excel.Range)
  58         Return CDbl(r.get_Cells.get_Count)
  59     End Function
  60
  61 #End Region
  62
  63
  64 #Region "Registration of Automation Add-in"
  65
  66     ''' <summary>
  67     ''' This is function which is called when we register the dll
  68     ''' </summary>
  69     ''' <param name="type"></param>
  70     ''' <remarks></remarks>
  71     <ComRegisterFunction()> _
  72     Public Shared Sub RegisterFunction(ByVal type As Type)
  73
  74         ' Add the "Programmable" registry key under CLSID
  75         Registry.ClassesRoot.CreateSubKey(GetCLSIDSubKeyName( _
  76                                           type, "Programmable"))
  77
  78         ' Register the full path to mscoree.dll which makes Excel happier.
  79         Dim key As RegistryKey = Registry.ClassesRoot.OpenSubKey( _
  80         GetCLSIDSubKeyName(type, "InprocServer32"), True)
  81         key.SetValue("", (Environment.SystemDirectory & "\mscoree.dll"), _
  82                      RegistryValueKind.String)
  83
  84     End Sub
  85
  86     ''' <summary>
  87     ''' This is function which is called when we unregister the dll
  88     ''' </summary>
  89     ''' <param name="type"></param>
  90     ''' <remarks></remarks>
  91     <ComUnregisterFunction()> _
  92     Public Shared Sub UnregisterFunction(ByVal type As Type)
  93
  94         ' Remove the "Programmable" registry key under CLSID
  95         Registry.ClassesRoot.DeleteSubKey( _
  96         GetCLSIDSubKeyName(type, "Programmable"), False)
  97
  98     End Sub
  99
 100     ''' <summary>
 101     ''' Assistant function used by RegisterFunction/UnregisterFunction
 102     ''' </summary>
 103     ''' <param name="type"></param>
 104     ''' <param name="subKeyName"></param>
 105     ''' <returns></returns>
 106     ''' <remarks></remarks>
 107     Private Shared Function GetCLSIDSubKeyName( _
 108     ByVal type As Type, ByVal subKeyName As String) As String
 109
 110         Dim s As New StringBuilder
 111         s.Append("CLSID\{")
 112         s.Append(type.GUID.ToString.ToUpper)
 113         s.Append("}\")
 114         s.Append(subKeyName)
 115         Return s.ToString
 116
 117     End Function
 118
 119 #End Region
 120
 121 End Class